home *** CD-ROM | disk | FTP | other *** search
/ MacGames Sampler / PHT MacGames Bundle.iso / MacSource Folder / Samples from the CD / Editors / emacs / Emacs-1.14b1 / lisp / mac / stacksize.el < prev    next >
Encoding:
Text File  |  1994-03-08  |  3.1 KB  |  100 lines  |  [TEXT/EMAC]
  1. ;;;
  2. ;;; This file is part of a Macintosh port of GNU Emacs.
  3. ;;; Copyright (C) 1993, 1994 Marc Parmet.  All rights reserved.
  4. ;;;
  5. ;;; GNU Emacs is distributed in the hope that it will be useful,
  6. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  7. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  8. ;;; GNU General Public License for more details.
  9. ;;;
  10.  
  11. (defconst stacksize-ok-button 1)
  12. (defconst stacksize-cancel-button 2)
  13. (defconst stacksize-stack-item 3)
  14.  
  15. (defun do-stacksize (menu item)
  16.   (let ((d (GetNewDialog 130 0 -1))
  17.         item-str
  18.         item-int
  19.         (type (make-string (c:sizeof 'short) 0))
  20.         (h (make-string (c:sizeof 'Handle) 0))
  21.         (s (make-string 256 0))
  22.         (box (make-rect))
  23.         (old-value (let ((pref (get-preference "DATA" 129)))
  24.                      (if (< pref 0)
  25.                          min-stack-size
  26.                        (prog2
  27.                         (HLock pref)
  28.                         (max min-stack-size (extract-internal (deref pref) 0 'long))
  29.                         (HUnlock pref))))))
  30.     (setq item-str (NewPtr 2))
  31.     (if (zerop (MemError))
  32.         (progn
  33.           (GetDItem d stacksize-stack-item type h box)
  34.           (SetIText (extract-internal h 0 'unsigned-long)
  35.                     (CtoPstr (int-to-string old-value)))
  36.           (SelIText d stacksize-stack-item 0 32767)
  37.           (ShowWindow d)
  38.           (InitCursor)
  39.           (encode-internal item-str 0 'short 0)
  40.           (while (progn (setq item-int (extract-internal item-str 0 'short))
  41.                         (and (not (= item-int stacksize-ok-button))
  42.                              (not (= item-int stacksize-cancel-button))))
  43.             (ModalDialog (function stacksize-filter) item-str))
  44.           
  45.           (GetDItem d stacksize-stack-item type h box)
  46.           (GetIText (extract-internal h 0 'unsigned-long) s)
  47.           (if (= item-int stacksize-ok-button)
  48.               (let ((k (NewHandle (c:sizeof 'long))))
  49.                 (if (zerop (MemError))
  50.                     (let ((new-pref (max min-stack-size (string-to-int (PtoCstr s)))))
  51.                       (HLock k)
  52.                       (encode-internal (deref k) 0 'unsigned-long new-pref)
  53.                       (HUnlock k)
  54.                       (set-preference "DATA" 129 k)))))))
  55.     
  56.     (DisposeDialog d)))
  57.  
  58. (defun stacksize-filter (d e i)
  59.   (let ((what (c:slotref 'EventRecord e 'what)))
  60.     (cond
  61.      ((= what updateEvt)
  62.       (let ((type (make-string 2 0))
  63.         (item (make-string 4 0))
  64.         (box (make-string 8 0)))
  65.     (GetDItem d stacksize-ok-button type item box)
  66.     (SetPort d)
  67.     (PenSize 3 3)
  68.     (InsetRect box -4 -4)
  69.     (FrameRoundRect box 16 16)
  70.     (PenNormal)
  71.     0))
  72.      ((= what keyDown)
  73.       (let ((c (logand (c:slotref 'EventRecord e 'message) charCodeMask))
  74.         (modifiers (c:slotref 'EventRecord e 'modifiers)))
  75.     (if (or (= c (string-to-char "\r")) (= c 3))
  76.         (progn
  77.           (encode-internal i 0 'short stacksize-ok-button)
  78.           (blink d stacksize-ok-button)
  79.           1)
  80.       (if (and (= c (string-to-char ".")) (not (zerop (logand modifiers cmdKey))))
  81.         (progn
  82.           (encode-internal i 0 'short stacksize-cancel-button)
  83.           (blink d stacksize-cancel-button)
  84.           1)
  85.         0))))
  86.      (t
  87.       0))))
  88.  
  89. (defun blink (d item)
  90.   (let ((type (make-string 2 0))
  91.     (h0 (make-string 4 0))
  92.     (box (make-string 8 0))
  93.     (now (TickCount)))
  94.     (GetDItem d item type h0 box)
  95.     (let ((h (extract-internal h0 0 'unsigned-long)))
  96.       (HiliteControl h inButton)
  97.       (while (< (TickCount) (+ 10 now))
  98.     nil)
  99.       (HiliteControl h 0))))
  100.